home *** CD-ROM | disk | FTP | other *** search
Modula Implementation | 1995-11-25 | 4.5 KB | 131 lines |
- IMPLEMENTATION MODULE WindowMenue;
-
- FROM SYSTEM IMPORT ADDRESS,VAL,TSIZE;
-
- FROM EasyWindow IMPORT windowlist,windowtype,SetInfo;
-
- FROM GEMAESbase IMPORT WorkXYWH, GraphicTitle,HideTree,None,Object;
-
- FROM AES IMPORT MenuBar,WindowGet;
-
- FROM Strings IMPORT Concat;
-
- PROCEDURE GetObjectPointer(Index :INTEGER; TreePtr:ADDRESS) : ADDRESS;
- BEGIN
- RETURN TreePtr+VAL(ADDRESS, (Index*TSIZE(Object)));
- END GetObjectPointer;
-
-
-
- PROCEDURE InstallMenu(WindowHandle : INTEGER; MenuTree:ADDRESS):BOOLEAN;
-
- TYPE String = ARRAY [0..80] OF CHAR;
- VAR
- win : windowtype;
- x,y,w,h : INTEGER;
- cx,cy,cw,ch : INTEGER; (* Koordinaten Gesammtfenster *)
- wx,wy,ww,wh : INTEGER; (* Koordinaten Arbeitsbereich *)
- dx,dy,dw,dh : INTEGER; (* Bildschirmausmaße *)
- Index1,Index2 : INTEGER;(* Menü Indices *)
- MenuWidth : INTEGER; (* Menübreite *)
- tail,tail2,
- head,head2,
- temp1,temp2 : INTEGER; (* div Abkürzungen *)
- tailptr,tail2ptr,
- headptr,head2ptr,
- rootptr,
- index1ptr,index2ptr : POINTER TO Object;
- buf : ADDRESS;
- sp : POINTER TO String;
- t : String;
- OK :BOOLEAN;
-
-
- BEGIN
- t[0]:=' ';t[1]:=3C;t[2]:=0C;
- rootptr:=GetObjectPointer(0,MenuTree);
- tail:=rootptr^.tail;
- tailptr:=GetObjectPointer(tail,MenuTree);
- tail2:=tailptr^.head;
- head:=rootptr^.head;
- headptr:=GetObjectPointer(head,MenuTree);
- head2:=headptr^.head;
- head2ptr:=GetObjectPointer(head2,MenuTree);
- (* Ist das Fenster vorhanden,oben,offen ? *)
- IF windowlist[WindowHandle] # NIL THEN
- IF windowlist[WindowHandle]^.opened AND windowlist[WindowHandle]^.ontop THEN
- win:=windowlist[WindowHandle]^;
- windowlist[WindowHandle]^.reference:=MenuTree;
- (* Größe des Fensters ermitteln *)
-
- cx:=win.total.x; cy:=win.total.y;
- cw:=win.total.w; ch:=win.total.h;
-
- wx:=win.work.x; wy:=win.work.y;
- ww:=win.work.w; wh:=win.work.h;
-
- x:=cx;y:=cy;h:=ch;w:=cw;
- (* neue Position der Menüzeile *)
- rootptr^.x:=cx+1;
- MenuX:=cx;
- rootptr^.y:=cy+((wy-cy)DIV 2);(* für Fenster mit Infozeile sonst nur y+ch-cw*)
- MenuY:=cy+((wy-cy)DIV 2);
- MenuH:=(wy-cy)DIV 2;
- (* geht die Menüzeile über den Fensterrand hinaus ? *)
- WindowGet(0,WorkXYWH,dx,dy,dw,dh);
- IF (x+1 (*+w-cw*) +ww>dx+dw) THEN
- w:=dw+dx-(x+1)+cw-ww-1;
- END(*IF*);
- (* Breite der Menüzeile = Breite des Fensters bzw Bildschirms *)
- headptr^.width:=w-cw+ww;
- Index1:=head2ptr^.head;
- index1ptr:=GetObjectPointer(Index1,MenuTree);
- Index2:= tail2;
- index2ptr:=GetObjectPointer(Index2,MenuTree);
- head2ptr^.width:=0;
-
- WHILE index1ptr^.type=GraphicTitle DO
- (* Breite des Menü-Titels *)
- temp1:=rootptr^.x+headptr^.x+head2ptr^.x+index1ptr^.x+index1ptr^.width;
- (* Breite des Menüeintrages *)
- temp2:=rootptr^.x+tailptr^.x+index2ptr^.x+index2ptr^.width;
- (* welche Menüs passen noch auf den Bildschirm bzw. ins Fenster *)
- IF ((temp1>=dx+dw) OR (temp2>=dx+dw) OR
- (temp1>=x+w-cw+ww) OR (temp2>=x+w-cw+ww)) THEN
- (* alle nicht mehr auf den Bildschirm passenden Menüs abschalten *)
- WHILE index1ptr^.type=GraphicTitle DO
- index1ptr^.flags:=HideTree;
- Index1:=index1ptr^.next;
- index1ptr:=GetObjectPointer(Index1,MenuTree);
- END(*WHILE*);
- ELSE
- (* Breite der Menüzeile anpassen *)
- head2ptr^.width:=index1ptr^.x+index1ptr^.width;
- MenuW:=head2ptr^.width;
- (* Menü eingeshaltet *)
- index1ptr^.flags:=None;
- (* Menüeintrage als Info setzen *)
- sp:=index1ptr^.spec;
- Concat(t,sp^,t,OK);
- Index1:=index1ptr^.next;
- Index2:=index2ptr^.next;
- index1ptr:=GetObjectPointer(Index1,MenuTree);
- index2ptr:=GetObjectPointer(Index2,MenuTree);
- END(*IF*);
- END(*WHILE*);
- (* Menüzeile zeichnen *)
- MenuBar(MenuTree,1);
- SetInfo(WindowHandle,t);
- RETURN TRUE
- END(*IF*); (* falls das Fenster nicht offen bzw oberstes Fenster war *)
- END(*IF*); (* falls kein Fenster mit handle = WindowHandle da ist *)
- RETURN FALSE
- END InstallMenu;
-
- BEGIN
- MenuX:=0;
- MenuY:=0;
- MenuW:=0;
- MenuH:=0;
- END WindowMenue.
-